unit GLTerrain;

interface

uses
  Winapi.OpenGL,
  Winapi.OpenGLext,
  Winapi.Windows,
  System.SysUtils,
  System.Math,
  System.Classes,
  Vcl.Graphics,

  GLS.Scene,
  GLS.VectorGeometry,
  GLS.GeometryBB,
  GLS.Texture,
  GLS.Material,
  GLS.VectorLists,
  GLS.RenderContextInfo,
  GLS.OpenGLTokens,
  GLS.Utils,
  GLS.Triangulation;

type

  TGLBaseTerrain = class(TGLBaseSceneObject)
  private
    fSize: Integer;
    fMaxHeight: Integer;
    fLOD: Integer;

    fTriCount: Integer;
    fThreshold: Integer;
    fWireframe: Boolean;

  protected
    procedure SetLOD(val: Integer);
    procedure BuildErrorMetric(var error: PByteArray); virtual;
  public
    OnProgress: TdProgressevent;
    Invisibleindices: TGLIntegerList;
    heightmap: TBitmap;
    Player: TGLBaseSceneObject;
    hscale, vscale: double;
    MatLib: TGLMaterialLibrary;
    texturecache, DetailCache: cardinal;
    detailname, texname: string;
    aabb: TAABB;
    texturemap: TBitmap;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure InvertFaceVisibility(const ax, az: Single);
    procedure ReadFromStringList(sl: TStringlist; var index: Integer);
    procedure WriteToStringList(var sl: TStringlist);

    procedure LoadHeightmapFromFile(filename: string);
    procedure LoadHeightmapFromStream(stream: TStream; asize: Integer);
    procedure LoadHeightmapFromBitmap(aImage: TBitmap);

    procedure ExtractTriangles(list: TGLAffineVectorList); virtual;
    function InterpolatedHeight(const ax, az: Single;
      pNormal: PAffinevector = nil): Single;
    function RayCastIntersectHeightmap(RayStart, RayVector: TAffinevector;
      IPoint: PAffinevector): Boolean;

    procedure GetExtents(var amin, amax: TAffinevector);
    procedure structurechanged; override;

    procedure Init; virtual;
    procedure DeInit; virtual;

    procedure BuildList(var rci: TGLRenderContextInfo); override;
    property LOD: Integer read fLOD write SetLOD;
    property MaxHeight: Integer read fMaxHeight;
    property Size: Integer read fSize;
    property Tricount: Integer read fTriCount;
    property Threshold: Integer read fThreshold write fThreshold;
    property Wireframe: Boolean read fWireframe write fWireframe;
  end;

  TGLSimpleTerrain = class(TGLBaseTerrain)
  public
    procedure BuildList(var rci: TGLRenderContextInfo); override;
    procedure ExtractTriangles(list: TGLAffineVectorList); override;
  end;

  TErrorHeuristic = function(bm: TBitmap; x, z, step: Integer): Integer;

  TGLDelaunayTerrain = class(TGLBaseTerrain)
  protected
    procedure BuildErrorMetric(var error: PByteArray); override;
  public
    ErrorHeuristic: TErrorHeuristic;
    constructor Create(AOwner: TComponent); override;
    procedure BuildList(var rci: TGLRenderContextInfo); override;
    procedure ExtractTriangles(list: TGLAffineVectorList); override;

  end;

function Errorheuristic3x3(bm: TBitmap; x, z, step: Integer): Integer;
function Errorheuristic5x5(bm: TBitmap; x, z, step: Integer): Integer;

procedure parseLine(line: String; var ll: TStringlist);
procedure Set8BitPalette(bm: TBitmap);
procedure Tilebitmap(src, dest: TBitmap; w, h: Integer);

// =======================================================================
implementation

// =======================================================================

procedure Tilebitmap(src, dest: TBitmap; w, h: Integer);
var
  x, y: Integer;
begin
  dest.Width := w;
  dest.Height := h;

  dest.Canvas.Draw(0, 0, src);
  for x := 0 to (w DIV src.Width) do
    for y := 0 to (h DIV src.Height) do
    begin
      if (x = 0) AND (y = 0) then
        continue;
      dest.Canvas.Draw(x * src.Width, y * src.Height, src);
    end;
end;

function Errorheuristic3x3(bm: TBitmap; x, z, step: Integer): Integer;
var
  xs, zs, x2, z2: Integer;
  y: Integer;
  lowest, highest: byte;
  line: PByteArray;
begin
  xs := bm.Width;
  zs := bm.Height;
  lowest := 255;
  highest := 0;
  z2 := z - step;

  while (z2 < z + step) and (z2 < zs - step) do
  begin

    if z2 > -1 then
    begin
      line := bm.scanline[z2];
      x2 := x - step;
      while (x2 < x + step) and (x2 < xs) do
      begin
        if x2 > -1 then
        begin
          y := line[x2];
          if y < lowest then
            lowest := y;
          if y > highest then
            highest := y;
        end;
        inc(x2, step);
      end;
    end;
    inc(z2, step);
  end;
  if highest >= lowest then
    result := highest - lowest
  else
    result := 255;
end;

function Errorheuristic5x5(bm: TBitmap; x, z, step: Integer): Integer;
var
  xs, zs, x2, z2: Integer;
  y: Integer;
  lowest, highest: byte;
  line: PByteArray;
begin
  xs := bm.Width;
  zs := bm.Height;
  lowest := 255;
  highest := 0;
  z2 := z - (step * 2);
  while (z2 < z + (step * 2)) and (z2 < zs - step) do
  begin
    if z2 > -1 then
    begin
      line := bm.scanline[z2];
      x2 := x - (step * 2);
      while (x2 < x + (step * 2)) and (x2 < xs) do
      begin
        if x2 > -1 then
        begin
          y := line[x2];
          if y < lowest then
            lowest := y;
          if y > highest then
            highest := y;
        end;
        inc(x2, step);
      end;
    end;
    inc(z2, step);
  end;
  if highest >= lowest then
    result := highest - lowest
  else
    result := 255;
end;

procedure parseLine(line: String; var ll: TStringlist);
var
  index: Integer;
begin
  ll.clear;
  line := trim(line);
  index := pos(' ', line);
  while (index > 0) OR ((pos('"', line) > 0) AND (length(line) > 1)) do
  begin
    if line[1] = '"' then
    begin
      delete(line, 1, 1);
      if pos('"', line) > 0 then
      begin
        index := pos('"', line);
        delete(line, index, 1);
      end;
    end;

    ll.add(copy(line, 1, index - 1));

    delete(line, 1, index);
    line := trim(line);
    index := pos(' ', line);
  end;
  if length(line) > 0 then
    ll.add(line);
end;

procedure Set8BitPalette(bm: TBitmap);
var
  i: Integer;
  NewPalette: TMaxLogPalette;
begin
  bm.PixelFormat := pf8bit;
  NewPalette.palVersion := $0300; // "Magic Number" for Windows LogPalette
  NewPalette.palNumEntries := 256;

  for i := 0 to 255 do
  begin
    NewPalette.palPalEntry[i].peRed := i;
    NewPalette.palPalEntry[i].peGreen := i;
    NewPalette.palPalEntry[i].peBlue := i;
    NewPalette.palPalEntry[i].peFlags := PC_NOCOLLAPSE;
  end;
  bm.Palette := CreatePalette(pLogPalette(@NewPalette)^);
end;

/// //////////////////////////////////////////////////////////////////////////

constructor TGLBaseTerrain.Create(AOwner: TComponent);
begin
  inherited;
  fTriCount := 0;
  heightmap := TBitmap.Create;
  fLOD := 1;
  hscale := 1;
  vscale := 0.1;
  Invisibleindices := TGLIntegerList.Create;
  OnProgress := nil;
  texname := 'null';
  detailname := 'null';
  // newtonobject.collidertype := nccollisiontree;
end;

destructor TGLBaseTerrain.Destroy;
var
  y: Integer;
begin
  heightmap.free;
  Invisibleindices.free;
  DeInit;
  inherited;
end;

procedure TGLBaseTerrain.ReadFromStringList(sl: TStringlist;
  var index: Integer);
var
  ll: TStringlist;
procedure nextline;
begin
  index := index + 1;
  parseLine(sl[index], ll);
end;

begin

  ll := TStringlist.Create;
  nextline;

  hscale := strtofloatdef(ll[0]);
  vscale := strtofloatdef(ll[1]);
  fThreshold := strtoint(ll[2]);
  fLOD := strtoint(ll[3]);

  nextline;
  detailname := ll[0];
  nextline;
  texname := ll[0];
  ll.free;
end;

procedure TGLBaseTerrain.WriteToStringList(var sl: TStringlist);
var
  i: Integer;
begin
  sl.add('terrain');

  sl.add(format('%.4f %.4f %.d %.d', [hscale, vscale, fThreshold, fLOD]));
  if detailname = '' then
    sl.add('"null"')
  else
    sl.add(format('"%s"', [detailname]));

  if texname = '' then
    sl.add('"null"')
  else
    sl.add(format('"%s"', [texname]));

  sl.add('end');
end;

procedure TGLBaseTerrain.Init;
begin
end;

procedure TGLBaseTerrain.DeInit;
begin
end;

procedure TGLBaseTerrain.SetLOD(val: Integer);
begin
  if val <> fLOD then
  begin
    fLOD := val;
    structurechanged;
  end;
end;

procedure TGLBaseTerrain.structurechanged;
var
  temp: tgllibmaterial;
begin
  fTriCount := (Size - 1) * (Size - 1);
  Init;

  aabb.min := position.asaffinevector;
  aabb.max := vectoradd(aabb.min, affinevectormake(Size * hscale, 255 * vscale,
    Size * hscale));
  inherited;
end;

procedure TGLBaseTerrain.GetExtents(var amin, amax: TAffinevector);
begin
  amin := aabb.min;
  amax := aabb.max;
end;

procedure TGLBaseTerrain.InvertFaceVisibility(const ax, az: Single);
var
  x, z: Integer;
  i: Integer;
  invisible: Boolean;
begin

  z := (trunc(abs((az - position.z) / hscale)) div fLOD) * fLOD;
  x := (trunc(abs((ax - position.x) / hscale)) div fLOD) * fLOD;

  if (x > -1) and (x < Size) and (z > -1) and (z < Size) then
  begin
    invisible := false;
    for i := 0 to Invisibleindices.count - 1 do
    begin
      if Invisibleindices[i] = (z * Size) + x then
      begin
        Invisibleindices.delete(i);
        invisible := true;
        break;

      end;
    end;
    if not invisible then
      Invisibleindices.add((z * Size) + x);

    inherited structurechanged;
  end;
end;

function TGLBaseTerrain.InterpolatedHeight(const ax, az: Single;
  pNormal: PAffinevector = nil): Single;
var
  lx, ly: Integer;
  x, z, dx, dz: Single;
  mx, mz, { i, } c: Integer;
  ix, iz, ixn, izn: Integer;
  h1, h2, h3, h4: Single;
  p1, p2, p3: TAffinevector;
  // ha: array[0..2] of single;
  tri: tAffinematrix;
  line: PByteArray;
begin
  result := 0;

  z := abs((az - position.z) / hscale);
  x := abs((ax - position.x) / hscale);

  if (x > -1) and (x < Size) and (z > -1) and (z < Size) then
  begin
    ix := trunc(x);
    x := Frac(x);
    iz := trunc(z);
    z := Frac(z);
    ixn := ix + 1;
    if ixn >= Size then
      ixn := Size - 1;
    izn := iz + 1;
    if izn >= Size then
      izn := Size - 1;

    if x > z then
    begin
      // top-right triangle
      line := heightmap.scanline[iz];
      h1 := line[ixn]; // data[(iz * size) + ixn];
      h2 := line[ix]; // data[(iz * size) + ix];
      line := heightmap.scanline[izn];
      h3 := line[ixn]; // data[(izn * size) + ixn];
      result := h1 + (h2 - h1) * ((1 - x)) + (h3 - h1) * (z);
    end
    else
    begin
      // bottom-left triangle
      line := heightmap.scanline[izn];
      h1 := line[ix]; // data[(izn * size) + ix];
      h2 := line[ixn]; // data[(izn * size) + ixn];
      line := heightmap.scanline[iz];
      h3 := line[ix]; // data[(iz * size) + ix];
      result := h1 + (h2 - h1) * (x) + (h3 - h1) * (1 - z);
    end;
  end;

  if assigned(pNormal) then
    pNormal^ := affinevectormake(0, 1, 0);

  result := position.y + (result * vscale);
end;

procedure TGLBaseTerrain.LoadHeightmapFromFile(filename: string);
var
  stream: TFilestream;
  i: Integer;
  temp: TBitmap;
begin
  if lowercase(extractfileext(filename)) = '.bmp' then
  begin
    // temp := TBitmap.create;
    // temp.LoadFromFile(filename);
    // temp.PixelFormat := pf24bit;
    { if newsize <> 0 then
      resample(temp, fImage, newsize, newsize, Lanczos3Filter, 3, nil)
      else }
    // temp.PixelFormat:=pf24bit;

    // gblur(temp, 3);
    // Set8BitPalette(temp);
    // Heightmap.assign(temp);
    // temp.free;

    heightmap.LoadFromFile(filename);

    fSize := heightmap.Width;

    structurechanged;
  end
  else
  begin
    stream := TFilestream.Create(filename, fmOpenRead);
    LoadHeightmapFromStream(stream, stream.Size);
    stream.free;
  end;
end;

procedure TGLBaseTerrain.BuildErrorMetric(var error: PByteArray);
begin
  // nothing
end;

procedure TGLBaseTerrain.LoadHeightmapFromBitmap(aImage: TBitmap);
begin
  heightmap.assign(aImage);
  Set8BitPalette(heightmap);
  fSize := heightmap.Width;
  structurechanged;
end;

procedure TGLBaseTerrain.LoadHeightmapFromStream(stream: TStream;
  asize: Integer);
var
  y: Integer;
  temp: TBitmap;
begin
  temp := TBitmap.Create;
  temp.Width := round(sqrt(asize));

  temp.Height := temp.Width;
  temp.PixelFormat := pf8bit;
  for y := 0 to temp.Height - 1 do
    stream.read(temp.scanline[y]^, temp.Width);

  heightmap.assign(temp);
  temp.free;

  fSize := heightmap.Width - 1;
  structurechanged;
end;

procedure TGLBaseTerrain.ExtractTriangles(list: TGLAffineVectorList);
begin
  // nothing
end;

procedure TGLBaseTerrain.BuildList;
var
  temp: tgllibmaterial;
begin
  inherited;
  if assigned(MatLib) then
  begin
    if (System.length(texname) > 0) then
    begin
      temp := MatLib.Materials.GetLibMaterialByName(texname);
      if assigned(temp) then
        texturecache := temp.Material.Texture.Handle;
    end;
    if (System.length(detailname) > 0) then
    begin
      temp := MatLib.Materials.GetLibMaterialByName(detailname);
      if assigned(temp) then
        DetailCache := temp.Material.Texture.Handle;
    end;
  end;
end;

function TGLBaseTerrain.RayCastIntersectHeightmap(RayStart,
  RayVector: TAffinevector; IPoint: PAffinevector): Boolean;
var
  pos, spos: TAffinevector;
  line: PByteArray;
  px, pz, prevpx, prevpz: Integer;
  y: Single;
  firstloop: Boolean;
begin
  spos := vectorsubtract(RayStart, self.position.asaffinevector);
  spos.x := spos.x / hscale;
  spos.y := spos.y / vscale;
  spos.z := spos.z / hscale;
  // scalevector(spos, affinevectormake(1/hscale, 1/vscale, 1/hscale));

  pos := RayStart;
  result := false;
  firstloop := true;
  while true do
  begin
    pos := vectoradd(pos, RayVector);
    px := round(pos.x);
    pz := round(pos.z);
    if firstloop then
    begin
      firstloop := false;
      prevpx := px;
      prevpz := pz;
    end;

    // if ray is travelling away from the heightmap
    if ((spos.x < 0) and (px < prevpx)) or ((spos.z < 0) and (pz < prevpz)) or
      ((spos.x > Size - 1) and (px > prevpx)) or
      ((spos.z > Size - 1) and (pz > prevpz)) then
      break;

    // if (prevpx = px) and (prevpz = pz) then
    // continue;
    prevpx := px;
    prevpz := pz;

    // travelled past the heightmap without hitting anything
    if ((spos.x > px) and (px < 0)) or ((spos.z > px) and (pz < 0)) or
      ((spos.x < pz) and (px > Size - 1)) or ((spos.z < pz) and (pz > Size - 1))
    then
      break;


    // if (px < 0) or(pz < 0) or
    // (px > size-1)or(pz > size-1) then
    // continue;
    // line:=heightmap.scanline[pz];
    // py:=line[px];

    y := InterpolatedHeight(px, pz);

    // hit something
    if pos.y <= y then
    begin
      result := true;
      if assigned(IPoint) then
      begin
        // scalevector(pos, affinevectormake(hscale, vscale,hscale));
        // ipoint^ := vectoradd(pos, self.position.AsAffineVector);
        IPoint^ := pos;
        IPoint^.y := y;
      end;
      break;
    end;
  end;
end;
/// //////////////////////////////////////////////////////////////////////////

procedure TGLSimpleTerrain.BuildList;
var
  xs, zs: Integer;
  x, y, z, i, x1, y1: Integer;
  u, v, u2, v2: Single;
  invisible, stripping: Boolean;
  line: PByteArray;
begin
  inherited;
  glpushattrib(GL_ENABLE_BIT or gl_polygon_bit);
  /// ////////////////////////////
  if Wireframe then
    glpolygonmode(gl_front, gl_line);

  gldisable(gl_lighting);
  glActiveTextureARB(GL_TEXTURE0_ARB);
  glEnable(GL_TEXTURE_2D);
  glBindTexture(GL_TEXTURE_2D, texturecache);

  glActiveTextureARB(GL_TEXTURE1_ARB);
  glEnable(GL_TEXTURE_2D);

  glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_COMBINE_EXT);
  glTexEnvi(GL_TEXTURE_ENV, GL_RGB_SCALE_EXT, 1);

  glBindTexture(GL_TEXTURE_2D, DetailCache);
  glMatrixMode(GL_TEXTURE);

  glLoadIdentity();
  glScalef(hscale * 8, hscale * 8, 1);

  glMatrixMode(GL_MODELVIEW);

  /// ////////////////////////////////////////
  zs := Size;
  xs := Size;

  // glPolygonmode(GL_FRONT, GL_LINE);
  z := 0;

  glpushmatrix;
  glScalef(hscale, vscale, hscale);
  glcolor3f(1, 1, 1);
  stripping := false;
  // gltranslatef(-fimage.Width*0.5,0,-fimage.Height*0.5);
  while z < zs - fLOD do
  begin // horizontal strips

    x := 0;
    while x < xs do
    begin
      // glcolor3f(1-(y/255), 1-(y/255),1-(y/255)); // here for testing - replace
      invisible := false;
      if Invisibleindices.count > 0 then
        for i := 0 to Invisibleindices.count - 1 do
        begin
          if Invisibleindices[i] = (z * Size) + x then
          begin
            invisible := true;
            break;
          end;
        end;
      if not invisible then
      begin
        if not stripping then
        begin
          glBegin(GL_TRIANGLE_STRIP);
          stripping := true;
        end;
        // for y1:=0 to lod-1 do
        // for x1:=0 to lod-1 do
        // y:=y+data[((z+y1) * size) + (x+x1)];
        // y:=y div sqr(lod);

        line := heightmap.scanline[z];
        y := line[x]; // data[(z * size) + x];

        v := (zs - z) / zs;
        v2 := v - (fLOD / zs);
        u := x / xs;

        glMultiTexCoord2fARB(GL_TEXTURE0_ARB, u, v);
        glMultiTexCoord2fARB(GL_TEXTURE1_ARB, u, v);
        glVertex3f(x, y, z);

        line := heightmap.scanline[z + fLOD];
        y := line[x]; // data[((z + flod) * size) + x];
        glMultiTexCoord2fARB(GL_TEXTURE0_ARB, u, v2);
        glMultiTexCoord2fARB(GL_TEXTURE1_ARB, u, v2);
        glVertex3f(x, y, (z + fLOD));
      end
      else
      begin
        if stripping then
        begin
          line := heightmap.scanline[z];

          y := line[x]; // data[(z * size) + x];

          v := (zs - z) / zs;
          v2 := v - (fLOD / zs);
          u := x / xs;

          glMultiTexCoord2fARB(GL_TEXTURE0_ARB, u, v);
          glMultiTexCoord2fARB(GL_TEXTURE1_ARB, u, v);
          glVertex3f(x, y, z);

          line := heightmap.scanline[z + fLOD];
          y := line[x]; // data[((z + flod) * size) + x];
          glMultiTexCoord2fARB(GL_TEXTURE0_ARB, u, v2);
          glMultiTexCoord2fARB(GL_TEXTURE1_ARB, u, v2);
          glVertex3f(x, y, (z + fLOD));

          stripping := false;
          glend;
        end;
      end;
      inc(x, fLOD);
    end;
    if stripping then
    begin
      stripping := false;
      glend;
    end;
    inc(z, fLOD);
  end;
  glpopmatrix;

  /// ////////////////////////
  glActiveTextureARB(GL_TEXTURE1_ARB);
  gldisable(GL_TEXTURE_2D);
  glActiveTextureARB(GL_TEXTURE0_ARB);
  gldisable(GL_TEXTURE_2D);
  /// /////////////////////////
  glpopattrib;

end;

procedure TGLSimpleTerrain.ExtractTriangles(list: TGLAffineVectorList);
var
  x, y, i: Integer;
  v1: TAffinevector;
  xoffs, zoffs: Single;
  xs, ys: Integer;
  invisible: Boolean;
  line: PByteArray;
begin
  inherited;
  ys := Size;
  xs := Size;

  xoffs := -(xs * scale.x) * 0.5;
  zoffs := -(ys * scale.z) * 0.5;

  y := 0;
  while y < ys - fLOD do
  begin
    line := heightmap.scanline[y];
    x := 0;
    while x < xs - fLOD do
    begin
      invisible := false;
      for i := 0 to Invisibleindices.count - 1 do
        if Invisibleindices[i] = (y * Size) + x then
        begin
          invisible := true;
          break;
        end;
      if not invisible then
      begin

        list.add(x, line[x] { data[((y + alod) * size) + x] } , y + fLOD);
        list.add(x + fLOD,
          line[x + fLOD] { data[((y + alod) * size) + (x + alod)] } , y + fLOD);
        list.add(x + fLOD,
          line[x + fLOD] { data[(y * size) + (x + alod)] } , y);

        list.add(x + fLOD,
          line[x + fLOD] { data[(y * size) + (x + alod)] } , y);
        list.add(x, line[x] { data[(y * size) + x] } , y);
        list.add(x, line[x + fLOD] { data[((y + alod) * size) + x] } ,
          y + fLOD);

        for i := 0 to 5 do
        begin
          v1 := list[list.count - (i + 1)];
          scalevector(v1, affinevectormake(hscale, vscale, hscale));

          // v1 := RotateAroundY(v1, rot[1]);
          // v1 := RotateAroundZ(v1, rot[2]);
          // v1 := RotateAroundX(v1, rot[0]);
          // v1 := transform(v1, globalmatrix);

          // v1 := Add(v1, add(Pos.asVectors3, vector(xoffs, 0, zoffs)));

          list[list.count - (i + 1)] := v1;
        end;
      end;
      inc(x, fLOD);
    end;
    inc(y, fLOD);
  end;
end;

/// //////////////////////////////////////////////////////////////////////////

constructor TGLDelaunayTerrain.Create(AOwner: TComponent);
begin
  inherited;
  ErrorHeuristic := Errorheuristic3x3;
end;

procedure TGLDelaunayTerrain.BuildErrorMetric(var error: PByteArray);
var
  xs, zs, x, z, i, j, x2, z2: Integer;
  invisible, corner: Boolean;
  y, count: Integer;
  line: PByteArray;
begin
  inherited;
  zs := Size;
  xs := Size;

  z := 0;
  while z < zs - fLOD do
  begin
    x := 0;
    while x < xs do
    begin
      { if error[(z * size) + x]=255 then
        begin
        inc(x,flod);
        continue;
        end; }
      if Assigned(OnProgress) then
        OnProgress('Calculating error metrics', (z * Size) + x, Size * Size);

      invisible := false;
      if Invisibleindices.count > 0 then
        for i := 0 to Invisibleindices.count - 1 do
        begin
          if Invisibleindices[i] = (z * Size) + x then
          begin
            invisible := true;
            break;
          end;
        end;

      if (not invisible) then
      begin
        corner := false;
        if (x = 0) or (x = zs - fLOD) then
        begin
          if (z = 0) or (z = zs - (fLOD * 2)) then
            corner := true;
        end;

        if (not corner) and assigned(ErrorHeuristic) then
          error[(z * Size) + x] := ErrorHeuristic(heightmap, x, z, fLOD)
        else
          error[(z * Size) + x] := 255;
      end
      else
      begin
        { for i:=-2 to 2 do
          for j:=-2 to 2 do
          if (x+j<xs) and (z+i<zs-flod) and
          (x+j>-1) and (z+i>-1) then
          begin
          error[((z+i) * size) + (x+j)] := 255;
          end; }
        error[(z * Size) + x] := 0;
      end;

      inc(x, fLOD);
    end;
    inc(z, fLOD);
  end;
end;

procedure TGLDelaunayTerrain.BuildList;
var
  xs, zs: Integer;
  x, y, z, i, j, x1, y1: Integer;
  u, v, u2, v2: Single;
  d: TGLDelaunay2D;
  vert: DVertex;
  line, error: PByteArray;
  invisible: Boolean;
begin
  inherited;
  zs := Size;
  xs := Size;

  d := TGLDelaunay2D.Create;
  d.OnProgress := OnProgress;
  GetMem(error, sqr(Size));
  // fillchar(error^, sqr(size), 255);

  BuildErrorMetric(error);

  // if invisibleindices.count > 0 then
  // for i := 0 to invisibleindices.count - 1 do
  // error[invisibleindices[i]] := 0;
  z := 0;
  fMaxHeight := 0;
  while z < zs - fLOD do
  begin
    x := 0;
    line := heightmap.scanline[z];
    while x < xs do
    begin
      if { (error[(z * size) + x]=0) or } (error[(z * Size) + x] > fThreshold)
      then
      begin
        u := x / xs;
        v := (zs - z) / zs;
        y := line[x]; // data[(z * size) + x];
        if y > fMaxHeight then
          fMaxHeight := y;

        d.AddPointNoCheck(x, z, y, u, v, 0); // z and y are swapped
      end;
      inc(x, fLOD);
    end;
    inc(z, fLOD);
  end;

  aabb.max := vectoradd(aabb.min, affinevectormake(Size * hscale,
    fMaxHeight * vscale, Size * hscale));

  d.Mesh(true);
  fTriCount := d.Howmany;

  // glpushattrib(GL_ENABLE_BIT or Gl_polygon_bit);
  /// ////////////////////////////
  // if wireframe then
  // glpolygonmode(gl_front, gl_line);
  // gldisable(gl_lighting);

  glActiveTextureARB(GL_TEXTURE0_ARB);
  glEnable(GL_TEXTURE_2D);
  glBindTexture(GL_TEXTURE_2D, texturecache);
  glActiveTextureARB(GL_TEXTURE1_ARB);
  glEnable(GL_TEXTURE_2D);

  glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_COMBINE_EXT);
  glTexEnvi(GL_TEXTURE_ENV, GL_RGB_SCALE_EXT, 1);

  glBindTexture(GL_TEXTURE_2D, DetailCache);
  glMatrixMode(GL_TEXTURE);

  glLoadIdentity;
  glScalef(hscale * 8, hscale * 8, 1);

  glMatrixMode(GL_MODELVIEW);

  glpushmatrix;
  glScalef(hscale, vscale, hscale);
  glcolor3f(1, 1, 1);
  if Tricount > 0 then
  begin
    j := 0;
    glBegin(gl_triangles);
    for i := 1 to fTriCount do
    begin
      inc(j);
      if j > 10000 then
      begin
        j := 0;
        glend;
        glBegin(gl_triangles);
      end;
      if Assigned(OnProgress) then
        OnProgress('Building display list', i - 1, fTriCount);

      vert := d.Vertex[d.Triangle[i].vv0];
      glMultiTexCoord2fARB(GL_TEXTURE0_ARB, vert.u, vert.v);
      glMultiTexCoord2fARB(GL_TEXTURE1_ARB, vert.u, vert.v);
      glVertex3f(vert.x, vert.z, vert.y);

      vert := d.Vertex[d.Triangle[i].vv1];
      glMultiTexCoord2fARB(GL_TEXTURE0_ARB, vert.u, vert.v);
      glMultiTexCoord2fARB(GL_TEXTURE1_ARB, vert.u, vert.v);
      glVertex3f(vert.x, vert.z, vert.y);

      vert := d.Vertex[d.Triangle[i].vv2];
      glMultiTexCoord2fARB(GL_TEXTURE0_ARB, vert.u, vert.v);
      glMultiTexCoord2fARB(GL_TEXTURE1_ARB, vert.u, vert.v);
      glVertex3f(vert.x, vert.z, vert.y);

    end;
    glend;
  end;
  glpopmatrix;

  /// ////////////////////////
  glActiveTextureARB(GL_TEXTURE1_ARB);
  gldisable(GL_TEXTURE_2D);
  glActiveTextureARB(GL_TEXTURE0_ARB);
  gldisable(GL_TEXTURE_2D);
  /// /////////////////////////
  // glpopattrib;

  d.free;

  FreeMem(error);
  if assigned(OnProgress) then
    OnProgress('Finished.', 1, 1)
end;

procedure TGLDelaunayTerrain.ExtractTriangles(list: TGLAffineVectorList);
var
  xs, zs: Integer;
  x, y, z, i: Integer;
  u, v, u2, v2: Single;
  d: TGLDelaunay2D;
  vert: DVertex;
  line, error: PByteArray;

begin
  inherited;
  zs := Size;
  xs := Size;

  d := TGLDelaunay2D.Create;

  getmem(error, sqr(Size));
  // fillchar(error^, sqr(size), 255);

  BuildErrorMetric(error);

  // if invisibleindices.count > 0 then
  // for i := 0 to invisibleindices.count - 1 do
  // error[invisibleindices[i]] := 0;
  z := 0;
  while z < zs - fLOD do
  begin
    x := 0;
    line := heightmap.scanline[z];
    while x < xs do
    begin
      if error[(z * Size) + x] > fThreshold then
      begin
        u := x / xs;
        v := (zs - z) / zs;
        y := line[x];

        d.AddPointNoCheck(x, z, y, u, v, 0); // z and y are swapped
      end;
      inc(x, fLOD);
    end;
    inc(z, fLOD);
  end;

  d.Mesh(true);
  fTriCount := d.Howmany;

  for i := 1 to fTriCount do
  begin
    vert := d.Vertex[d.Triangle[i].vv0];
    list.add(vert.x * hscale, vert.z * vscale, vert.y * hscale);

    vert := d.Vertex[d.Triangle[i].vv1];
    list.add(vert.x * hscale, vert.z * vscale, vert.y * hscale);

    vert := d.Vertex[d.Triangle[i].vv2];
    list.add(vert.x * hscale, vert.z * vscale, vert.y * hscale);
  end;
  d.free;

  FreeMem(error);
end;

end.
